home *** CD-ROM | disk | FTP | other *** search
/ Chip 2005 April / CHIP_CD_2005-04.iso / software / phoa / phoa-setup-1.1.9.exe / {app} / API / phPhoa.pas < prev   
Pascal/Delphi Source File  |  2004-12-31  |  51KB  |  1,111 lines

  1. //**********************************************************************************************************************
  2. //  $Id: phPhoa.pas,v 1.11 2004/12/31 13:38:58 dale Exp $
  3. //----------------------------------------------------------------------------------------------------------------------
  4. //  PhoA image arranging and searching tool
  5. //  Copyright DK Software, http://www.dk-soft.org/
  6. //**********************************************************************************************************************
  7. //**********************************************************************************************************************
  8. //
  9. // PhoA file format description
  10. // The whole code (c)2002-2005 Dmitry Kann, except where otherwise explicitly
  11. // noted
  12. // Home site:
  13. //   http://www.dk-soft.org/
  14. //
  15. // ATTENTION! None of this code can be reproduced in any form without prior
  16. // permission issued by the author.
  17. //
  18. // This unit describes general photo album file structure introduced in PhoA
  19. // picture arranging program in release 1.1.1a. This revision is known as
  20. // 'Revision 3' of .phoa file, and is the first one that supports so-called
  21. // chunk-based organization, and therefore is extensible. Revisions 1 and 2
  22. // were fixed-structure binary files, now they are proprietary PhoA formats
  23. // supported only by the program itself. Their specifications may be supplied
  24. // on an additional request.
  25. //
  26. // Contact email: phoa@narod.ru
  27. //
  28. // Target platform: Borland Delphi 7
  29. // Target OS:       Windows
  30. // Language:        Object Pascal
  31. //
  32. // Change log:
  33. //   Dec 07, 2004 - dale - Added IPhChunk_View_FilterExpression chunk
  34. //   Nov 24, 2004 - dale - Fixes to TimeToPhoaTime() (now rounds the time value to minimize the errors)
  35. //   Nov 19, 2004 - dale - Added new sorting properties (thumbnail width, height and dimensions) and sorting prop constants
  36. //   Jun 06, 2004 - dale - Added a chunk for Group Description property
  37. //   Jun 02, 2004 - dale - Added a chunk for Group ID property
  38. //   May 30, 2004 - dale - Added chunks for picture Rotation and Flips properties
  39. //**********************************************************************************************************************
  40. unit phPhoa;
  41.  
  42. interface
  43. uses SysUtils, Windows, Classes;
  44.  
  45.    // 1. Introduction
  46.    // ===============
  47.    // Photo album files (phoa-files) are binary files accessible only with
  48.    // special programs. Native creator of .phoa is PhoA - picture arranging
  49.    // tool, which is available for free download at http://www.dk-soft.org/
  50.    //
  51.    // Phoa-files contain various data on how pictures are arranged in the
  52.    // album. At the moment there are five major logical sections in the
  53.    // phoa-file data:
  54.    //
  55.    //  - File header
  56.    //  - General photo album data
  57.    //  - Pictures and their data as they appear in the phoa storage
  58.    //  - Groups hierarchy and links to the pictures
  59.    //  - Additional album data and structures
  60.    //
  61.    // 2. Photo album file sections
  62.    // ============================
  63.    // 2.1 File header
  64.    // ---------------
  65.    // Phoa-file always starts with ASCII string 'PhoA [PhotoAlbum] project
  66.    // file', represented by SPhoAFileSignature constant.
  67.    //
  68.    // Next to the signature follows Revision Number: 4-byte signed integer,
  69.    // Intel byte-order. Current Revision Number is the value of the
  70.    // IPhFileRevisionNumber constant.
  71.    //
  72.    // The header contents are constant and do not differ between revisions
  73.    // (except Revision Number itself). This allows reliable recognition
  74.    // of newer revisions, with subsequent denial of opening, and also
  75.    // allows to build an unified opening procedure (at least for header).
  76.    //
  77.    // WARNING:
  78.    // All information below refers to Revision 3 (see the header of this file
  79.    // for details). Next sections operate with chunks as data storage blocks.
  80.    //
  81.    // 2.2 General photo album data
  82.    // ----------------------------
  83.    // These data include common photo album data such as album description or
  84.    // thumbnail compression rate, as described by corresponding chunks.
  85.    //
  86.    // 2.3 Pictures and their data as they appear in the phoa storage
  87.    // --------------------------------------------------------------
  88.    // A planar list of pictures, enclosed with the list open/close-chunks
  89.    //
  90.    // 2.4 Groups hierarchy and links to the pictures
  91.    // ----------------------------------------------
  92.    // Hierarchically (recursively) organized group tree, each group maintaining
  93.    // list of child groups as well as list of picture IDs
  94.    //
  95.    // 2.5 Additional album data and structures
  96.    // ----------------------------------------
  97.    // Other photo album data, such as views
  98.    //
  99.    // These sections are pretty relative (except 2.1), and must be overseen in
  100.    // each case.
  101.    //
  102.    // 3. Chunks
  103.    // =========
  104.    // Starting with the section 2.2 (right after header), all phoa-file data
  105.    // are organized with chunks (Revision 3+ !)
  106.    // A CHUNK is an unsigned 2-byte Intel-ordered value, ranged from $0000 to
  107.    // $ffff, each value has its own predetermined meaning (if any), described
  108.    // in IPhChunk_xxxxxx constants. Each chunk has its own, fixed datatype,
  109.    // which can never be changed in later releases. So if you have read chunk's
  110.    // code, you can say for sure what datatype it contains. Moreover, each
  111.    // chunk is followed by one-byte datatype code, and then datatype-specific
  112.    // number of data.
  113.    //
  114.    // So, common chunk structure is as follows:
  115.    //
  116.    // 2 bytes                     Chunk code
  117.    // 1 byte                      Datatype code
  118.    // N bytes (datatype-specific) Chunk data
  119.    //
  120.    // 3.1 Chunk datatypes
  121.    // -------------------
  122.    // Code Name        Data length        Description
  123.    //                    (bytes)
  124.    // ---- --------  -----------------  --------------------------------------------------------------------------------
  125.    //    0 Empty            0           A chunk with no data
  126.    //    1 Byte             1           unsigned 1-byte (0..255)
  127.    //    2 Word             2           unsigned 2-byte (0..65535)
  128.    //    3 Int              4           signed 4-byte (-2147483648..2147483647)
  129.    //    4 StringB      1+(0..255)      Ansi string, with length Byte preceding (max length 255 bytes)
  130.    //    5 StringW     2+(0..65535)     Ansi string (not a *wide* string), with length Word preceding (max length 65 KB)
  131.    //    6 StringI   4+(0..2147483647)  Ansi string, with length Int preceding (max length 2 GB)
  132.    //
  133.    //  * Note on chunk data types:
  134.    //    Only Intel byte-order is used, where $12345678 is represented as byte
  135.    //    sequence: $78,$56,$34,$12.
  136.    //    Each chunk has its own, fixed datatype, which can never be changed in
  137.    //    later releases. Any mismatch with predefined chunk datatype must be
  138.    //    treated as error.
  139.    //
  140.    // 3.2 Chunk codes
  141.    // ---------------
  142.    // According to stated above, chunk code is an unsigned 2-byte number. The
  143.    // datatype and meaning of each chunk is described along with its
  144.    // declaration.
  145.    //
  146.    // Chunk codes $4000..$4fff are open-chunks for nested elements, always
  147.    // having Empty datatype. Each open-chunk has corresponding close-chunk
  148.    // with bit 15 set (ranged $c000..$cfff), eg:
  149.    //   $4000 (open) -> $c000 (close)
  150.    //   $4001 (open) -> $c001 (close)
  151.    // & so on. This allows correct recognition of close-chunks knowing none of
  152.    // the open-chunk purpose.
  153.    //
  154.    // 4. Common phoa-file Reader behaviour
  155.    // ====================================
  156.    // An algorithm designed for reading phoa-files (the Reader) must conform
  157.    // to the following rules:
  158.    //
  159.    // - The Reader reads file header:
  160.    //   o Signature must be exact copy of the PhoA file signature, any mismatch
  161.    //     leads to an error.
  162.    //   o Revision must be 3 or higher for the Reader to treat file as
  163.    //     chunk-based, otherwise this is not chunk-organized phoa-file, and
  164.    //     Reader must implement specific routines to handle it.
  165.    //   o Each specific Revision means possible INCOMPATIBILITIES compared to
  166.    //     lower Revision. So Reader must NOT read Revision it is not intended
  167.    //     to read. Though common file structure would be possibly leaved
  168.    //     intact, there might be some changes in chunk handling so the Reader
  169.    //     can only try to handle such file 'at its own risk'. Generally, this
  170.    //     format was designed just not to be updated frequently. The ability
  171.    //     to handle files with higher revisions is controlled by
  172.    //     StrictRevision conditional define, turn it off to let Reader to
  173.    //     continue with parsing file of 'wrong' revision.
  174.    // - In case Revision is 3 or higher (otherwise see note at the beginning of
  175.    //   this file):
  176.    //   o The Reader processes each chunk one-by-one. The main chunk principle
  177.    //     (and goal) is expansibility, so if the Reader encounters chunk not
  178.    //     known to it, it must just SKIP this chunk whole (along with its
  179.    //     data and/or nested chunks). The purpose of skipping chunk with its
  180.    //     nested chunks is that a chunk cannot be reliably recognized without
  181.    //     its context.
  182.    //     * For known chunk Reader then retrieves its stored datatype code and
  183.    //       does or does not verify this datatype. Generally, mismathing chunk
  184.    //       datatype may rise from broken phoa-files and must be treated as
  185.    //       error.
  186.    //     * If chunk is open-chunk (always with no data, see above), the Reader
  187.    //       handles all subsequent chunks till the terminating close-chunk as
  188.    //       nested (action depends on a particular case).
  189.    //     * If chunk is a data-chunk, it may or may not be processed, depending
  190.    //       on the Reader implementation.
  191.    //
  192.    // Notes:
  193.    //  - The Group IDs introduced in PhoA 1.1.5 aren't supported in previous
  194.    //    versions, and therefore require some fixup. The fixup is that the
  195.    //    Reader should review all the groups once the loading is complete
  196.    //    assigning an unique ID to each group having no assigned one yet.
  197.    //    This workaround doesn't allow for steady referencing groups by ID
  198.    //    (as this ID may change each time the photo album is open, unless
  199.    //    you have saved it by a program version supporting the Group ID chunk),
  200.    //    but it is better than nothing.
  201.    //
  202.    // That is all for now. Yeah, quite long preface :)
  203.  
  204. {$DEFINE StrictRevision} // If defined, fail opening files with revisions higher than specified in this unit
  205.  
  206. type
  207.    // Possible chunk datatypes
  208.   TPhChunkDatatype = (pcdEmpty, pcdByte, pcdWord, pcdInt, pcdStringB, pcdStringW, pcdStringI);
  209.  
  210.   TPhChunkCode = Word;
  211.  
  212. const
  213.    // Phoa-file signature
  214.   SPhoAFileSignature               = 'PhoA [PhotoAlbum] project file'; // NEVER LOCALIZE!
  215.  
  216.    // Phoa-files revisions. Revision at index 0 is always the latest one
  217.   aPhFileRevisions: Array[0..2] of record
  218.     iNumber:  Integer; // Phoa-file Revision Number
  219.     sName:    String;  // Name of version family to recognize that revision
  220.     sMinName: String;  // Name of PhoA version introduced that revision
  221.   end = (
  222.     (iNumber: $0003; sName: 'PhoA 1.1+';  sMinName: '1.1.1a'),
  223.     (iNumber: $0002; sName: 'PhoA 1.0.x'; sMinName: '1.0.1a'),
  224.     (iNumber: $0001; sName: 'PhoA 0.x';   sMinName: '0.02b'));
  225.  
  226.    // Current photo album file Revision Number
  227.   IPhFileRevisionNumber            = $0003;
  228.    // Starting revision for chunk-based handling
  229.   IPhFile_MinChunkRevNumber        = $0003;
  230.  
  231.    //-------------------------------------------------------------------------------------------------------------------
  232.    // Chunk codes
  233.    //-------------------------------------------------------------------------------------------------------------------
  234.    // Base codes
  235.   IPhChunk_Open_Low                = $4000; // Low bound for all open-chunks
  236.   IPhChunk_Open_High               = $4fff; // High bound for all open-chunks
  237.   IPhChunk_Close_Low               = $c000; // Low bound for all close-chunks
  238.   IPhChunk_Close_High              = $cfff; // High bound for all close-chunks
  239.  
  240.    // General stuff
  241.   IPhChunk_Remark                  = $0000; // StringW  Any text, ignored by the Reader
  242.    // Common photo album data
  243.   IPhChunk_PhoaGenerator           = $1001; // StringB  Application created the album
  244.   IPhChunk_PhoaSavedDate           = $1002; // Int      Date file saved: number of days since Jan 01, 0001
  245.   IPhChunk_PhoaSavedTime           = $1003; // Int      Time file saved: number of seconds since midnight
  246.   IPhChunk_PhoaDescription         = $1010; // StringW  Photo album description text
  247.   IPhChunk_PhoaThumbQuality        = $1020; // Byte     Photo album thumbnail JPEG-quality level [1..100]
  248.   IPhChunk_PhoaThumbWidth          = $1021; // Word     Photo album thumbnail width  [32..1024]
  249.   IPhChunk_PhoaThumbHeight         = $1022; // Word     Photo album thumbnail height [32..1024]
  250.    // Picture properties
  251.   IPhChunk_Pic_ID                  = $1101; // Int      ID: an unique picture identifier, >=1
  252.   IPhChunk_Pic_ThumbnailData       = $1110; // StringI  Picture thumnail: JPEG data stream
  253.   IPhChunk_Pic_ThumbWidth          = $1111; // Word     Thumbnail width in pixels
  254.   IPhChunk_Pic_ThumbHeight         = $1112; // Word     Thumbnail height in pixels
  255.   IPhChunk_Pic_PicFileName         = $1120; // StringW  Absolute or relative (to the phoa-file) picture filename
  256.   IPhChunk_Pic_PicFileSize         = $1121; // Int      Picture file size, bytes
  257.   IPhChunk_Pic_PicWidth            = $1122; // Int      Image width, pixels
  258.   IPhChunk_Pic_PicHeight           = $1123; // Int      Image height, pixels
  259.   IPhChunk_Pic_PicFormat           = $1124; // Byte     Pixel image format ID (see below)
  260.   IPhChunk_Pic_Date                = $1130; // Int      Date: number of days since Jan 01, 0001
  261.   IPhChunk_Pic_Time                = $1131; // Int      Time: number of seconds since midnight
  262.   IPhChunk_Pic_Place               = $1132; // StringW  Place
  263.   IPhChunk_Pic_FilmNumber          = $1133; // StringW  Film number or name
  264.   IPhChunk_Pic_FrameNumber         = $1134; // StringB  Frame number
  265.   IPhChunk_Pic_Author              = $1135; // StringW  Picture author
  266.   IPhChunk_Pic_Media               = $1136; // StringW  Media name or code
  267.   IPhChunk_Pic_Desc                = $1137; // StringW  Description
  268.   IPhChunk_Pic_Notes               = $1138; // StringW  Notes
  269.   IPhChunk_Pic_Keywords            = $1139; // StringW  Keywords: Comma-separated list. Single entries containing spaces or commas must be double-quoted
  270.   IPhChunk_Pic_Rotation            = $1140; // Byte     Image Rotation ID (see below)
  271.   IPhChunk_Pic_Flips               = $1141; // Byte     Image Flip flags (see below)
  272.    // Picture group properties
  273.   IPhChunk_Group_ID                = $1200; // Int      Group ID
  274.   IPhChunk_Group_Text              = $1201; // StringW  Group text (name)
  275.   IPhChunk_Group_Expanded          = $1202; // Byte     Group-node expanded flag (0/1)
  276.   IPhChunk_Group_Description       = $1203; // StringW  Group description 
  277.    // Picture linked in group properties
  278.   IPhChunk_GroupPic_ID             = $1220; // Int      Link to picture (the picture's ID)
  279.    // Photo album view properties
  280.   IPhChunk_View_Name               = $1301; // StringW  View name
  281.   IPhChunk_View_FilterExpression   = $1302; // StringW  View picture filter expression
  282.   IPhChunk_ViewGrouping_Prop       = $1310; // Word     View grouping property (see below)
  283.   IPhChunk_ViewGrouping_Unclass    = $1311; // Byte     View grouping switch: place unclassified pictures to a separate folder (0/1)
  284.   IPhChunk_ViewSorting_Prop        = $1320; // Word     View sorting property (see below)
  285.   IPhChunk_ViewSorting_Order       = $1321; // Byte     View sorting sort direction: 0=Ascending, 1=Descending
  286.    // Open-chunks
  287.   IPhChunk_Pics_Open               = $4010; // Empty    Open-chunk for photo album picture list
  288.   IPhChunk_Pic_Open                = $4011; // Empty    Open-chunk for single photo album picture entry (inside the list)
  289.   IPhChunk_Group_Open              = $4020; // Empty    Open-chunk for single picture group (root or nested)
  290.   IPhChunk_Groups_Open             = $4021; // Empty    Open-chunk for nested picture groups
  291.   IPhChunk_GroupPics_Open          = $4030; // Empty    Open-chunk for pics contained in the group
  292.   IPhChunk_Views_Open              = $4050; // Empty    Open-chunk for photo album views
  293.   IPhChunk_View_Open               = $4060; // Empty    Open-chunk for single photo album view
  294.   IPhChunk_ViewGroupings_Open      = $4061; // Empty    Open-chunk for photo album view groupings
  295.   IPhChunk_ViewGrouping_Open       = $4062; // Empty    Open-chunk for single photo album view grouping
  296.   IPhChunk_ViewSortings_Open       = $4063; // Empty    Open-chunk for photo album view sortings
  297.   IPhChunk_ViewSorting_Open        = $4064; // Empty    Open-chunk for single photo album view sorting
  298.    // Close-chunks
  299.   IPhChunk_Pics_Close              = $c010; // Empty    Close-chunk for photo album picture list
  300.   IPhChunk_Pic_Close               = $c011; // Empty    Close-chunk for single photo album picture entry (inside the list)
  301.   IPhChunk_Group_Close             = $c020; // Empty    Close-chunk for single picture group (root or nested)
  302.   IPhChunk_Groups_Close            = $c021; // Empty    Close-chunk for nested picture groups
  303.   IPhChunk_GroupPics_Close         = $c030; // Empty    Close-chunk for pics contained in the group
  304.   IPhChunk_Views_Close             = $c050; // Empty    Close-chunk for photo album views
  305.   IPhChunk_View_Close              = $c060; // Empty    Close-chunk for single photo album view
  306.   IPhChunk_ViewGroupings_Close     = $c061; // Empty    Close-chunk for photo album view groupings
  307.   IPhChunk_ViewGrouping_Close      = $c062; // Empty    Close-chunk for single photo album view grouping
  308.   IPhChunk_ViewSortings_Close      = $c063; // Empty    Close-chunk for photo album view sortings
  309.   IPhChunk_ViewSorting_Close       = $c064; // Empty    Close-chunk for single photo album view sorting
  310.  
  311.    // Sorting property values
  312.   IPhSortingProp_ID                =  0; // Picture ID
  313.   IPhSortingProp_FileName          =  1; // Picture filename
  314.   IPhSortingProp_FullFileName      =  2; // Picture filename with path
  315.   IPhSortingProp_FilePath          =  3; // Picture file path
  316.   IPhSortingProp_FileSize          =  4; // Picture file size
  317.   IPhSortingProp_FileSizeBytes     =  5; // Picture file size in bytes (for sorting is just the same as 'Picture file size')
  318.   IPhSortingProp_PicWidth          =  6; // Image width
  319.   IPhSortingProp_PicHeight         =  7; // Image height
  320.   IPhSortingProp_PicDims           =  8; // Image dimensions
  321.   IPhSortingProp_Format            =  9; // Pixel format
  322.   IPhSortingProp_Date              = 10; // Date
  323.   IPhSortingProp_Time              = 11; // Time
  324.   IPhSortingProp_Place             = 12; // Place
  325.   IPhSortingProp_FilmNumber        = 13; // Film number
  326.   IPhSortingProp_FrameNumber       = 14; // Frame number
  327.   IPhSortingProp_Author            = 15; // Author
  328.   IPhSortingProp_Description       = 16; // Description
  329.   IPhSortingProp_Notes             = 17; // Notes
  330.   IPhSortingProp_Media             = 18; // Media
  331.   IPhSortingProp_Keywords          = 19; // Keywords (keywords are always ordered alphabetically, case-insensitively)
  332.   IPhSortingProp_Rotation          = 20; // Rotation
  333.   IPhSortingProp_Flips             = 21; // Flips
  334.   IPhSortingProp_ThumbWidth        = 22; // Thumbnail image width
  335.   IPhSortingProp_ThumbHeight       = 23; // Thumbnail image height
  336.   IPhSortingProp_ThumbDims         = 24; // Thumbnail image dimensions
  337.  
  338. type
  339.    // Local chunk entry, used in aPhChunks[]
  340.   PPhChunkEntry = ^TPhChunkEntry;
  341.   TPhChunkEntry = record
  342.     wCode:     TPhChunkCode;     // Chunk code, one of the IPhChunk_xxxxxx constants
  343.     Datatype:  TPhChunkDatatype; // Predefined chunk datatype
  344.     iRangeMin: Integer;          // Low value limit (for ordinal values)
  345.     iRangeMax: Integer;          // High value limit (for ordinal values)
  346.   end;
  347.  
  348.    // List of chunks known for the moment, and their datatypes and ranges
  349. const
  350.   aPhChunks: Array[0..61] of TPhChunkEntry = (
  351.     (wCode: IPhChunk_Remark;                 Datatype: pcdStringW),
  352.     (wCode: IPhChunk_PhoaGenerator;          Datatype: pcdStringB),
  353.     (wCode: IPhChunk_PhoaSavedDate;          Datatype: pcdInt;    iRangeMin: 0;  iRangeMax: 3652058 {Dec 31, 9999}),
  354.     (wCode: IPhChunk_PhoaSavedTime;          Datatype: pcdInt;    iRangeMin: 0;  iRangeMax: 24*60*60),
  355.     (wCode: IPhChunk_PhoaDescription;        Datatype: pcdStringW),
  356.     (wCode: IPhChunk_PhoaThumbQuality;       Datatype: pcdByte;   iRangeMin: 1;  iRangeMax: 100),
  357.     (wCode: IPhChunk_PhoaThumbWidth;         Datatype: pcdWord;   iRangeMin: 32; iRangeMax: 1024),
  358.     (wCode: IPhChunk_PhoaThumbHeight;        Datatype: pcdWord;   iRangeMin: 32; iRangeMax: 1024),
  359.     (wCode: IPhChunk_Pic_ID;                 Datatype: pcdInt;    iRangeMin: 1;  iRangeMax: High(Integer)),
  360.     (wCode: IPhChunk_Pic_ThumbnailData;      Datatype: pcdStringI),
  361.     (wCode: IPhChunk_Pic_ThumbWidth;         Datatype: pcdWord;   iRangeMin: 32; iRangeMax: 1024),
  362.     (wCode: IPhChunk_Pic_ThumbHeight;        Datatype: pcdWord;   iRangeMin: 32; iRangeMax: 1024),
  363.     (wCode: IPhChunk_Pic_PicFileName;        Datatype: pcdStringW),
  364.     (wCode: IPhChunk_Pic_PicFileSize;        Datatype: pcdInt;    iRangeMin: 0;  iRangeMax: High(Integer)),
  365.     (wCode: IPhChunk_Pic_PicWidth;           Datatype: pcdInt;    iRangeMin: 0;  iRangeMax: High(Integer)),
  366.     (wCode: IPhChunk_Pic_PicHeight;          Datatype: pcdInt;    iRangeMin: 0;  iRangeMax: High(Integer)),
  367.     (wCode: IPhChunk_Pic_PicFormat;          Datatype: pcdByte;   iRangeMin: 0;  iRangeMax: 8),
  368.     (wCode: IPhChunk_Pic_Date;               Datatype: pcdInt;    iRangeMin: 0;  iRangeMax: 3652058 {Dec 31, 9999}),
  369.     (wCode: IPhChunk_Pic_Time;               Datatype: pcdInt;    iRangeMin: 0;  iRangeMax: 24*60*60),
  370.     (wCode: IPhChunk_Pic_Place;              Datatype: pcdStringW),
  371.     (wCode: IPhChunk_Pic_FilmNumber;         Datatype: pcdStringW),
  372.     (wCode: IPhChunk_Pic_FrameNumber;        Datatype: pcdStringB),
  373.     (wCode: IPhChunk_Pic_Author;             Datatype: pcdStringW),
  374.     (wCode: IPhChunk_Pic_Media;              Datatype: pcdStringW),
  375.     (wCode: IPhChunk_Pic_Desc;               Datatype: pcdStringW),
  376.     (wCode: IPhChunk_Pic_Notes;              Datatype: pcdStringW),
  377.     (wCode: IPhChunk_Pic_Keywords;           Datatype: pcdStringW),
  378.     (wCode: IPhChunk_Pic_Rotation;           Datatype: pcdByte;   iRangeMin: 0;  iRangeMax: 3),
  379.     (wCode: IPhChunk_Pic_Flips;              Datatype: pcdByte;   iRangeMin: 0;  iRangeMax: 3),
  380.     (wCode: IPhChunk_Group_ID;               Datatype: pcdInt;    iRangeMin: 1;  iRangeMax: High(Integer)),
  381.     (wCode: IPhChunk_Group_Text;             Datatype: pcdStringW),
  382.     (wCode: IPhChunk_Group_Expanded;         Datatype: pcdByte;   iRangeMin: 0;  iRangeMax: 1),
  383.     (wCode: IPhChunk_Group_Description;      Datatype: pcdStringW),
  384.     (wCode: IPhChunk_GroupPic_ID;            Datatype: pcdInt;    iRangeMin: 1;  iRangeMax: High(Integer)),
  385.     (wCode: IPhChunk_View_Name;              Datatype: pcdStringW),
  386.     (wCode: IPhChunk_View_FilterExpression;  Datatype: pcdStringW),
  387.     (wCode: IPhChunk_ViewGrouping_Prop;      Datatype: pcdWord;   iRangeMin: 0;  iRangeMax: 10),
  388.     (wCode: IPhChunk_ViewGrouping_Unclass;   Datatype: pcdByte;   iRangeMin: 0;  iRangeMax: 1),
  389.     (wCode: IPhChunk_ViewSorting_Prop;       Datatype: pcdWord;   iRangeMin: 0;  iRangeMax: 21),
  390.     (wCode: IPhChunk_ViewSorting_Order;      Datatype: pcdByte;   iRangeMin: 0;  iRangeMax: 1),
  391.     (wCode: IPhChunk_Pics_Open;              Datatype: pcdEmpty),
  392.     (wCode: IPhChunk_Pic_Open;               Datatype: pcdEmpty),
  393.     (wCode: IPhChunk_Group_Open;             Datatype: pcdEmpty),
  394.     (wCode: IPhChunk_Groups_Open;            Datatype: pcdEmpty),
  395.     (wCode: IPhChunk_GroupPics_Open;         Datatype: pcdEmpty),
  396.     (wCode: IPhChunk_Views_Open;             Datatype: pcdEmpty),
  397.     (wCode: IPhChunk_View_Open;              Datatype: pcdEmpty),
  398.     (wCode: IPhChunk_ViewGroupings_Open;     Datatype: pcdEmpty),
  399.     (wCode: IPhChunk_ViewGrouping_Open;      Datatype: pcdEmpty),
  400.     (wCode: IPhChunk_ViewSortings_Open;      Datatype: pcdEmpty),
  401.     (wCode: IPhChunk_ViewSorting_Open;       Datatype: pcdEmpty),
  402.     (wCode: IPhChunk_Pics_Close;             Datatype: pcdEmpty),
  403.     (wCode: IPhChunk_Pic_Close;              Datatype: pcdEmpty),
  404.     (wCode: IPhChunk_Group_Close;            Datatype: pcdEmpty),
  405.     (wCode: IPhChunk_Groups_Close;           Datatype: pcdEmpty),
  406.     (wCode: IPhChunk_GroupPics_Close;        Datatype: pcdEmpty),
  407.     (wCode: IPhChunk_Views_Close;            Datatype: pcdEmpty),
  408.     (wCode: IPhChunk_View_Close;             Datatype: pcdEmpty),
  409.     (wCode: IPhChunk_ViewGroupings_Close;    Datatype: pcdEmpty),
  410.     (wCode: IPhChunk_ViewGrouping_Close;     Datatype: pcdEmpty),
  411.     (wCode: IPhChunk_ViewSortings_Close;     Datatype: pcdEmpty),
  412.     (wCode: IPhChunk_ViewSorting_Close;      Datatype: pcdEmpty));
  413.  
  414.    // Possible values for Pixel Format are (see note below):
  415.    //
  416.    // Value  Default  Description
  417.    // -----  -------  --------------
  418.    //   0             Device-dependent
  419.    //   1             1-bit
  420.    //   2             4-bit
  421.    //   3             8-bit
  422.    //   4             15-bit
  423.    //   5             16-bit
  424.    //   6             24-bit
  425.    //   7             32-bit
  426.    //   8       *     Custom or unknown
  427.    //
  428.    // Possible values for Image Rotation are (see note below):
  429.    //
  430.    // Value  Default  Description
  431.    // -----  -------  --------------
  432.    //   0       *     No rotation (0 degrees)
  433.    //   1             90 degrees clockwise rotation
  434.    //   2             180 degrees rotation
  435.    //   3             270 degrees clockwise rotation (=90 degrees counter-clockwise rotation)
  436.    //
  437.    // Possible values for Image Flip flags are (see note below):
  438.    //
  439.    // Value  Default  Description
  440.    // -----  -------  --------------
  441.    //   0       *     No flips applied
  442.    //   1             Apply horizontal flip to the image
  443.    //   2             Apply vertical flip to the image
  444.    //   3             Apply both horizontal and vertical flips to the image
  445.    //
  446.    // Possible values for Grouping Property are (see note below):
  447.    //
  448.    // Value  Description
  449.    // -----  --------------
  450.    //   0    Picture file path
  451.    //   1    Date year
  452.    //   2    Date month
  453.    //   3    Date day
  454.    //   4    Time hour
  455.    //   5    Time minute
  456.    //   6    Place
  457.    //   7    Film number
  458.    //   8    Author
  459.    //   9    Media name/code
  460.    //  10    Keywords
  461.    //
  462.    // Possible values for Sorting Property are ones declared with IPhSortingProp_XXX constants (see note below):
  463.    //
  464.    // --------
  465.    // * Note on 'enumerated' values: the Reader should IGNORE values with
  466.    //     unknown code, this allows to extend specifications in future. The
  467.    //     'Default' value is just the one used for initializing (may be helpful
  468.    //     in such case), if applicable.
  469.  
  470.    // TPhoaStreamer status constants
  471.   IPhStatus_OK                     =  0; // Succeeded
  472.   IPhStatus_InvalidMode            =  1; // Invalid opening mode (trying to write in read mode and vice versa)
  473.   IPhStatus_CannotRead             =  2; // Stream read error
  474.   IPhStatus_CannotWrite            =  3; // Stream write error
  475.   IPhStatus_CannotAlterRevision    =  4; // Trying to modify Revision Number after some data have been written
  476.   IPhStatus_InvalidSignature       =  5; // Invalid phoa-file signature
  477.   IPhStatus_NotAChunkedFile        =  6; // File being open is not a chunk-based one, cannot be handled with this unit
  478.   IPhStatus_FileRevNewer           =  7; // File being open has higher revision than possible with this unit (was created with the newer program version)
  479.   IPhStatus_UnknownChunkToWrite    =  8; // Code of a chunk is unknown
  480.   IPhStatus_WrongDatatypePassed    =  9; // Wrong datatype passed to a WriteChunkxxxx() procedure
  481.   IPhStatus_InvalidDatatype        = 10; // Chunk datatype invalid or unknown
  482.  
  483. type
  484.    //-------------------------------------------------------------------------------------------------------------------
  485.    // Basic implementation of I/O routines (btw used in PhoA)
  486.    //-------------------------------------------------------------------------------------------------------------------
  487.  
  488.    // Base Exception class
  489.   EPhoaStreamerError = class(Exception)
  490.   private
  491.     FErrorCode: Integer;
  492.   public
  493.     constructor Create(const Msg: String; iErrCode: Integer);
  494.     constructor CreateFmt(const Msg: String; const Args: Array of const; iErrCode: Integer);
  495.      // Props
  496.      // -- Code of error encountered, one of the IPhStatus_xxxxxx constants
  497.     property ErrorCode: Integer read FErrorCode;
  498.   end;
  499.  
  500.   TPhoaStreamingMode = (psmRead, psmWrite);
  501.  
  502.    // Possible ReadChunk result
  503.   TPhReadingChunkResult = (
  504.     rcrOK,               // No errors
  505.     rcrUnknown,          // Chunk code is unknown
  506.     rcrInvalidDatatype,  // Datatype invalid or unknown (out of range)
  507.     rcrDatatypeMismatch, // Datatype mismatch
  508.     rcrEOF);             // No more chunks (end of file encountered)
  509.  
  510.    // Base class for storing/reading photo album data to/from a stream
  511.   TPhoaStreamer = class(TObject)
  512.   private
  513.      // Prop storage
  514.     FStream: TStream;
  515.     FMode: TPhoaStreamingMode;
  516.     FTransferredBytes: Cardinal;
  517.     FRevisionNumber: Integer;
  518.     FBasePath: String;
  519.     FErrorsOccured: Boolean;
  520.      // Prop handlers
  521.     procedure SetRevisionNumber(Value: Integer);
  522.     function  GetChunked: Boolean;
  523.   protected
  524.      // Writes specified number of bytes from Buffer to the file
  525.     procedure Write(const Buffer; iSize: Integer);
  526.      // Reads specified number of bytes from the file into Buffer
  527.     procedure Read(var Buffer; iSize: Integer);
  528.      // Raises an exception if RequiredMode<>Mode
  529.     procedure CheckMode(RequiredMode: TPhoaStreamingMode);
  530.      // Checking header data validity, virtual to have possibility to alter behaviour in a descendant
  531.     procedure ValidateSignature(const sReadSignature: String); virtual;
  532.     procedure ValidateRevision; virtual;
  533.   public
  534.     constructor Create(AStream: TStream; AMode: TPhoaStreamingMode; const sBasePath: String);
  535.      // Writing/reading routines for typed data
  536.     procedure WriteByte(b: Byte);
  537.     procedure WriteWord(w: Word);
  538.     procedure WriteInt(i: Integer);
  539.     procedure WriteStringB(const s: String);
  540.     procedure WriteStringW(const s: String);
  541.     procedure WriteStringI(const s: String);
  542.     function  ReadByte: Byte;
  543.     function  ReadWord: Word;
  544.     function  ReadInt: Integer;
  545.     function  ReadStringB: String;
  546.     function  ReadStringW: String;
  547.     function  ReadStringI: String;
  548.      // Writes/reads file header
  549.     procedure WriteHeader;
  550.     procedure ReadHeader;
  551.      // Writing/reading chunks (NO DATA are being written/read, only chunk code and datatype!)
  552.      // -- Version with auto-detecting chunk datatype
  553.     procedure WriteChunk(Code: TPhChunkCode); overload;
  554.      // -- Version with forced chunk datatype
  555.     procedure WriteChunk(Code: TPhChunkCode; Datatype: TPhChunkDatatype); overload;
  556.      // -- Version writing typed values (strict datatype)
  557.     procedure WriteChunkByte(Code: TPhChunkCode; b: Byte);
  558.     procedure WriteChunkWord(Code: TPhChunkCode; w: Word);
  559.     procedure WriteChunkInt(Code: TPhChunkCode; i: Integer);
  560.     procedure WriteChunkString(Code: TPhChunkCode; const s: String); // Auto-detecting type
  561.      // -- Reads chunk code and datatype
  562.     function  ReadChunk(out Code: TPhChunkCode; out Datatype: TPhChunkDatatype): TPhReadingChunkResult;
  563.      // -- Reads chunk code, datatype and value. Value is being read only if result is not rcrInvalidDatatype or rcrEOF,
  564.      //    invalid datatype raises exception. bSkipUnknown controls whether to skip unknown chunks (including all nested,
  565.      //    if necessary). bSkipUnmatched controls whether to skip chunks which datatype mismatches from predefined one
  566.     function  ReadChunkValue(out Code: TPhChunkCode; out Datatype: TPhChunkDatatype; var vValue: Variant; bSkipUnknown, bSkipUnmatched: Boolean): TPhReadingChunkResult;
  567.      // Skips all chunks until close-chunk for OpenCode chunk code encountered. May be used for ignoring unknown
  568.      //   open-chunks. It is valid to call SkipNestedChunks for non-open-chunks (ignored if it's the case)
  569.     procedure SkipNestedChunks(OpenCode: TPhChunkCode);
  570.      // Props
  571.      // -- True if chunk-based revision used
  572.     property Chunked: Boolean read GetChunked;
  573.      // -- Photo album file path (for translating relative picture file paths)
  574.     property BasePath: String read FBasePath;
  575.      // -- True if there were errors while reading or writing using the streamer
  576.     property ErrorsOccured: Boolean read FErrorsOccured write FErrorsOccured;
  577.      // -- Mode in which the object was created
  578.     property Mode: TPhoaStreamingMode read FMode;
  579.      // -- PhoA Revision Number, readonly in Read mode; can only be modified before any data are written
  580.     property RevisionNumber: Integer read FRevisionNumber write SetRevisionNumber;
  581.      // -- Stream used for transferring data
  582.     property Stream: TStream read FStream;
  583.      // -- Number of bytes read or written from/to the stream
  584.     property TransferredBytes: Cardinal read FTransferredBytes;
  585.   end;
  586.  
  587.    // Class for storing/reading photo album data to/from a file
  588.   TPhoaFiler = class(TPhoaStreamer)
  589.   private
  590.      // Real name of the file used to save the data
  591.     FWriteFilename: String;
  592.      // Prop handlers
  593.     FFilename: String;
  594.   public
  595.     constructor Create(AMode: TPhoaStreamingMode; const sFilename: String);
  596.     destructor Destroy; override;
  597.      // Props
  598.      // -- Open file name
  599.     property Filename: String read FFilename;
  600.   end;
  601.  
  602.    //-------------------------------------------------------------------------------------------------------------------
  603.    // Utility routines
  604.    //-------------------------------------------------------------------------------------------------------------------
  605.  
  606.    // Searches aPhChunks[] for a chunk code, returns pointer to entry if found, otherwise nil.
  607.   function FindChunk(Code: TPhChunkCode): PPhChunkEntry;
  608.    // The same as FindChunk(), but never returns nil; if Code not found, raises exception
  609.   function FindChunkStrict(Code: TPhChunkCode): PPhChunkEntry;
  610.    // Checking whether chunk Code is an open-chunk
  611.   function IsOpenChunk(Code: TPhChunkCode): Boolean;
  612.    // Checking whether chunk Code is close-chunk for chunk OpenCode
  613.   function IsCloseChunk(Code, OpenCode: TPhChunkCode): Boolean;
  614.  
  615.    // Date and time conversion
  616.    // Converts date into number of days passed since Jan 01, 0001
  617.   function  DateToPhoaDate(const Date: TDateTime): Integer;
  618.    // Converts time into number of seconds passed since midnight
  619.   function  TimeToPhoaTime(const Time: TDateTime): Integer;
  620.    // Converts phoa-date (days since Jan 01, 0001) into TDateTime type
  621.   function  PhoaDateToDate(iDate: Integer): TDateTime;
  622.    // Converts phoa-time (number of seconds since midnight) into TDateTime type
  623.   function  PhoaTimeToTime(iTime: Integer): TDateTime;
  624.  
  625. resourcestring
  626.    // Error messages
  627.   SPhStreamErr_InvalidMode         = 'Invalid opening mode';
  628.   SPhStreamErr_CannotRead          = 'Cannot read %d bytes from the stream';
  629.   SPhStreamErr_CannotWrite         = 'Cannot write %d bytes to the stream';
  630.   SPhStreamErr_CannotAlterRevision = 'RevisionNumber cannot be modified after some data have been written';
  631.   SPhStreamErr_InvalidSinature     = 'Invalid file signature';
  632.   SPhStreamErr_NotAChunkedFile     = 'File is not chunk-based (old format)';
  633.   SPhStreamErr_FileRevNewer        = 'File was created by the program version newer than this. The file cannot be loaded';
  634.   SPhStreamErr_UnknownChunkToWrite = 'Unknown chunk code to write (%d)';
  635.   SPhStreamErr_WrongDatatypePassed = 'Wrong Datatype of chunk passed to WriteChunkxxxxxx() (%s needed)';
  636.   SPhStreamErr_InvalidDatatype     = 'Chunk datatype invalid or unknown (code: %d)';
  637.  
  638. implementation
  639. uses Math, Variants;
  640.  
  641.   function FindChunk(Code: TPhChunkCode): PPhChunkEntry;
  642.   var i: Integer;
  643.   begin
  644.     for i := 0 to High(aPhChunks) do begin
  645.       Result := @aPhChunks[i];
  646.       if Result^.wCode=Code then Exit;
  647.     end;
  648.     Result := nil;
  649.   end;
  650.  
  651.   function FindChunkStrict(Code: TPhChunkCode): PPhChunkEntry;
  652.   begin
  653.     Result := FindChunk(Code);
  654.     if Result=nil then
  655.       raise EPhoaStreamerError.CreateFmt(SPhStreamErr_UnknownChunkToWrite, [Code], IPhStatus_UnknownChunkToWrite);
  656.   end;
  657.  
  658.   function IsOpenChunk(Code: TPhChunkCode): Boolean;
  659.   begin
  660.     Result := (Code>=IPhChunk_Open_Low) and (Code<=IPhChunk_Open_High);
  661.   end;
  662.  
  663.   function IsCloseChunk(Code, OpenCode: TPhChunkCode): Boolean;
  664.   begin
  665.     Result := (Code>=IPhChunk_Close_Low) and (Code<=IPhChunk_Close_High) and (Code=OpenCode or $8000);
  666.   end;
  667.  
  668.   function DateToPhoaDate(const Date: TDateTime): Integer;
  669.   begin
  670.     Result := Trunc(Date)-Trunc(EncodeDate(0001, 01, 01));
  671.   end;
  672.  
  673.   function TimeToPhoaTime(const Time: TDateTime): Integer;
  674.   begin
  675.     Result := Trunc(Frac(Time)*24*60*60+0.5);
  676.   end;
  677.  
  678.   function PhoaDateToDate(iDate: Integer): TDateTime;
  679.   begin
  680.     Result := iDate+EncodeDate(0001, 01, 01);
  681.   end;
  682.  
  683.   function PhoaTimeToTime(iTime: Integer): TDateTime;
  684.   begin
  685.     Result := Frac(iTime/(24*60*60));
  686.   end;
  687.  
  688.    // Raises 'Wrong Datatype passed' exception
  689.   procedure WrongWriteChunkDatatype(const sRequiredName: String);
  690.   begin
  691.     raise EPhoaStreamerError.CreateFmt(SPhStreamErr_WrongDatatypePassed, [sRequiredName], IPhStatus_WrongDatatypePassed);
  692.   end;
  693.  
  694.    //-------------------------------------------------------------------------------------------------------------------
  695.    // EPhoaStreamerError
  696.    //-------------------------------------------------------------------------------------------------------------------
  697.  
  698.   constructor EPhoaStreamerError.Create(const Msg: String; iErrCode: Integer);
  699.   begin
  700.     inherited Create(Msg);
  701.     FErrorCode := iErrCode;
  702.   end;
  703.  
  704.   constructor EPhoaStreamerError.CreateFmt(const Msg: String; const Args: Array of const; iErrCode: Integer);
  705.   begin
  706.     inherited CreateFmt(Msg, Args);
  707.     FErrorCode := iErrCode;
  708.   end;
  709.  
  710.    //-------------------------------------------------------------------------------------------------------------------
  711.    // TPhoaStreamer
  712.    //-------------------------------------------------------------------------------------------------------------------
  713.  
  714.   procedure TPhoaStreamer.CheckMode(RequiredMode: TPhoaStreamingMode);
  715.   begin
  716.     if FMode<>RequiredMode then raise EPhoaStreamerError.Create(SPhStreamErr_InvalidMode, IPhStatus_InvalidMode);
  717.   end;
  718.  
  719.   constructor TPhoaStreamer.Create(AStream: TStream; AMode: TPhoaStreamingMode; const sBasePath: String);
  720.   begin
  721.     inherited Create;
  722.     FStream         := AStream;
  723.     FMode           := AMode;
  724.     FBasePath       := sBasePath;
  725.     FRevisionNumber := IPhFileRevisionNumber; // Assume most modern revision by default
  726.   end;
  727.  
  728.   function TPhoaStreamer.GetChunked: Boolean;
  729.   begin
  730.     Result := FRevisionNumber>=IPhFile_MinChunkRevNumber;
  731.   end;
  732.  
  733.   procedure TPhoaStreamer.Read(var Buffer; iSize: Integer);
  734.   begin
  735.     try
  736.       CheckMode(psmRead);
  737.       if FStream.Read(Buffer, iSize)<>iSize then
  738.         raise EPhoaStreamerError.CreateFmt(SPhStreamErr_CannotRead, [iSize], IPhStatus_CannotRead);
  739.       Inc(FTransferredBytes, iSize);
  740.     except
  741.       FErrorsOccured := True;
  742.       raise;
  743.     end;
  744.   end;
  745.  
  746.   function TPhoaStreamer.ReadByte: Byte;
  747.   begin
  748.     Read(Result, SizeOf(Result));
  749.   end;
  750.  
  751.   function TPhoaStreamer.ReadChunk(out Code: TPhChunkCode; out Datatype: TPhChunkDatatype): TPhReadingChunkResult;
  752.   var pe: PPhChunkEntry;
  753.   begin
  754.     try
  755.        // Check if there are data at all
  756.       if FStream.Position>=FStream.Size then begin
  757.         Code     := 0;
  758.         Datatype := pcdEmpty;
  759.         Result   := rcrEOF;
  760.        // Read the chunk and its datatype
  761.       end else begin
  762.         Code     := ReadWord;
  763.         Datatype := TPhChunkDatatype(ReadByte);
  764.          // Try to find a chunk
  765.         pe := FindChunk(Code);
  766.          // Validate Datatype
  767.         if not (Datatype in [Low(Datatype)..High(Datatype)]) then Result := rcrInvalidDatatype
  768.          // If not found
  769.         else if pe=nil then Result := rcrUnknown
  770.          // Compare Datatype
  771.         else if Datatype<>pe.Datatype then Result := rcrDatatypeMismatch
  772.          // Ok
  773.         else Result := rcrOK;
  774.       end;
  775.     except
  776.       FErrorsOccured := True;
  777.       raise;
  778.     end;
  779.   end;
  780.  
  781.   function TPhoaStreamer.ReadChunkValue(out Code: TPhChunkCode; out Datatype: TPhChunkDatatype; var vValue: Variant; bSkipUnknown, bSkipUnmatched: Boolean): TPhReadingChunkResult;
  782.   var pe: PPhChunkEntry;
  783.   begin
  784.     try
  785.       vValue := Null;
  786.       repeat
  787.         Result := ReadChunk(Code, Datatype);
  788.         case Result of
  789.           rcrInvalidDatatype:  raise EPhoaStreamerError.CreateFmt(SPhStreamErr_InvalidDatatype, [Byte(Datatype)], IPhStatus_InvalidDatatype);
  790.           rcrEOF:              Break;
  791.         end;
  792.          // Read the value
  793.         case Datatype of
  794.           pcdByte:    vValue := ReadByte;
  795.           pcdWord:    vValue := ReadWord;
  796.           pcdInt:     vValue := ReadInt;
  797.           pcdStringB: vValue := ReadStringB;
  798.           pcdStringW: vValue := ReadStringW;
  799.           pcdStringI: vValue := ReadStringI;
  800.         end;
  801.          // Validate ranges for ordinal types. Outranged values assume unmatched
  802.         if (Result=rcrOK) and (Datatype in [pcdByte, pcdWord, pcdInt]) then begin
  803.           pe := FindChunk(Code);
  804.           if (vValue<pe.iRangeMin) or (vValue>pe.iRangeMax) then Result := rcrDatatypeMismatch;
  805.         end;
  806.          // Check the chunk for validity
  807.         case Result of
  808.           rcrOK:               Break;
  809.           rcrUnknown:          if not bSkipUnknown then Break;
  810.           rcrDatatypeMismatch: if not bSkipUnmatched then Break;
  811.         end;
  812.          // Chunk is to be skipped, if we're here. Check if it's nested one
  813.         SkipNestedChunks(Code);
  814.       until False;
  815.     except
  816.       FErrorsOccured := True;
  817.       raise;
  818.     end;
  819.   end;
  820.  
  821.   procedure TPhoaStreamer.ReadHeader;
  822.   var s: String;
  823.   begin
  824.     try
  825.        // Load and check signature
  826.       SetLength(s, Length(SPhoAFileSignature));
  827.       Read(s[1], Length(s));
  828.       ValidateSignature(s);
  829.        // Read Revision Number
  830.       FRevisionNumber := ReadInt;
  831.       ValidateRevision;
  832.     except
  833.       FErrorsOccured := True;
  834.       raise;
  835.     end;
  836.   end;
  837.  
  838.   function TPhoaStreamer.ReadInt: Integer;
  839.   begin
  840.     Read(Result, SizeOf(Result));
  841.   end;
  842.  
  843.   function TPhoaStreamer.ReadStringB: String;
  844.   var b: Byte;
  845.   begin
  846.     b := ReadByte;
  847.     SetLength(Result, b);
  848.     Read(Result[1], b);
  849.   end;
  850.  
  851.   function TPhoaStreamer.ReadStringI: String;
  852.   var i: Integer;
  853.   begin
  854.     i := ReadInt;
  855.     SetLength(Result, i);
  856.     Read(Result[1], i);
  857.   end;
  858.  
  859.   function TPhoaStreamer.ReadStringW: String;
  860.   var w: Word;
  861.   begin
  862.     w := ReadWord;
  863.     SetLength(Result, w);
  864.     Read(Result[1], w);
  865.   end;
  866.  
  867.   function TPhoaStreamer.ReadWord: Word;
  868.   begin
  869.     Read(Result, SizeOf(Result));
  870.   end;
  871.  
  872.   procedure TPhoaStreamer.SetRevisionNumber(Value: Integer);
  873.   begin
  874.     try
  875.       CheckMode(psmWrite);
  876.       if FTransferredBytes>0 then
  877.         raise EPhoaStreamerError.Create(SPhStreamErr_CannotAlterRevision, IPhStatus_CannotAlterRevision);
  878.       FRevisionNumber := Value;
  879.     except
  880.       FErrorsOccured := True;
  881.       raise;
  882.     end;
  883.   end;
  884.  
  885.   procedure TPhoaStreamer.SkipNestedChunks(OpenCode: TPhChunkCode);
  886.   var
  887.     wCode: TPhChunkCode;
  888.     Datatype: TPhChunkDatatype;
  889.     vValue: Variant;
  890.   begin
  891.     try
  892.       if IsOpenChunk(OpenCode) then
  893.         repeat
  894.           if ReadChunkValue(wCode, Datatype, vValue, True, True)=rcrEOF then Break;
  895.            // If nested-chunk-structure encountered, recurse it
  896.           SkipNestedChunks(wCode);
  897.         until IsCloseChunk(wCode, OpenCode);
  898.     except
  899.       FErrorsOccured := True;
  900.       raise;
  901.     end;
  902.   end;
  903.  
  904.   procedure TPhoaStreamer.ValidateRevision;
  905.   begin
  906.     try
  907.        // Check that we are dealing with chunk-based file
  908.       if not Chunked then raise EPhoaStreamerError.Create(SPhStreamErr_NotAChunkedFile, IPhStatus_NotAChunkedFile);
  909.       {$IFDEF StrictRevision}
  910.        // Check that RevisionNumber is 'normal' for proper handling
  911.       if FRevisionNumber>IPhFileRevisionNumber then
  912.         raise EPhoaStreamerError.Create(SPhStreamErr_FileRevNewer, IPhStatus_FileRevNewer);
  913.       {$ENDIF StrictRevision}
  914.     except
  915.       FErrorsOccured := True;
  916.       raise;
  917.     end;
  918.   end;
  919.  
  920.   procedure TPhoaStreamer.ValidateSignature(const sReadSignature: String);
  921.   begin
  922.     try
  923.       if sReadSignature<>SPhoAFileSignature then
  924.         raise EPhoaStreamerError.Create(SPhStreamErr_InvalidSinature, IPhStatus_InvalidSignature);
  925.     except
  926.       FErrorsOccured := True;
  927.       raise;
  928.     end;
  929.   end;
  930.  
  931.   procedure TPhoaStreamer.Write(const Buffer; iSize: Integer);
  932.   begin
  933.     try
  934.       CheckMode(psmWrite);
  935.       if FStream.Write(Buffer, iSize)<>iSize then
  936.         raise EPhoaStreamerError.CreateFmt(SPhStreamErr_CannotWrite, [iSize], IPhStatus_CannotWrite);
  937.       Inc(FTransferredBytes, iSize);
  938.     except
  939.       FErrorsOccured := True;
  940.       raise;
  941.     end;
  942.   end;
  943.  
  944.   procedure TPhoaStreamer.WriteByte(b: Byte);
  945.   begin
  946.     Write(b, SizeOf(b));
  947.   end;
  948.  
  949.   procedure TPhoaStreamer.WriteChunk(Code: TPhChunkCode);
  950.   begin
  951.     WriteChunk(Code, FindChunkStrict(Code)^.Datatype);
  952.   end;
  953.  
  954.   procedure TPhoaStreamer.WriteChunk(Code: TPhChunkCode; Datatype: TPhChunkDatatype);
  955.   begin
  956.     WriteWord(Code);
  957.     WriteByte(Byte(Datatype));
  958.   end;
  959.  
  960.   procedure TPhoaStreamer.WriteChunkByte(Code: TPhChunkCode; b: Byte);
  961.   var pe: PPhChunkEntry;
  962.   begin
  963.     try
  964.        // Find chunk entry
  965.       pe := FindChunkStrict(Code);
  966.       if pe.Datatype<>pcdByte then WrongWriteChunkDatatype('Byte');
  967.        // Write chunk/datatype code
  968.       WriteChunk(Code, pcdByte);
  969.        // Write chunk data
  970.       WriteByte(b);
  971.     except
  972.       FErrorsOccured := True;
  973.       raise;
  974.     end;
  975.   end;
  976.  
  977.   procedure TPhoaStreamer.WriteChunkInt(Code: TPhChunkCode; i: Integer);
  978.   var pe: PPhChunkEntry;
  979.   begin
  980.     try
  981.        // Find chunk entry
  982.       pe := FindChunkStrict(Code);
  983.       if pe.Datatype<>pcdInt then WrongWriteChunkDatatype('Int');
  984.        // Write chunk/datatype code
  985.       WriteChunk(Code, pcdInt);
  986.        // Write chunk data
  987.       WriteInt(i);
  988.     except
  989.       FErrorsOccured := True;
  990.       raise;
  991.     end;
  992.   end;
  993.  
  994.   procedure TPhoaStreamer.WriteChunkString(Code: TPhChunkCode; const s: String);
  995.   var pe: PPhChunkEntry;
  996.   begin
  997.     try
  998.        // Find chunk entry
  999.       pe := FindChunkStrict(Code);
  1000.       if not (pe.Datatype in [pcdStringB, pcdStringW, pcdStringI]) then WrongWriteChunkDatatype('StringB, StringW or StringI');
  1001.        // Write chunk/datatype code
  1002.       WriteChunk(Code, pe.Datatype);
  1003.        // Write chunk data
  1004.       case pe.Datatype of
  1005.         pcdStringB: WriteStringB(s);
  1006.         pcdStringW: WriteStringW(s);
  1007.         pcdStringI: WriteStringI(s);
  1008.       end;
  1009.     except
  1010.       FErrorsOccured := True;
  1011.       raise;
  1012.     end;
  1013.   end;
  1014.  
  1015.   procedure TPhoaStreamer.WriteChunkWord(Code: TPhChunkCode; w: Word);
  1016.   var pe: PPhChunkEntry;
  1017.   begin
  1018.     try
  1019.        // Find chunk entry
  1020.       pe := FindChunkStrict(Code);
  1021.       if pe.Datatype<>pcdWord then WrongWriteChunkDatatype('Word');
  1022.        // Write chunk/datatype code
  1023.       WriteChunk(Code, pcdWord);
  1024.        // Write chunk data
  1025.       WriteWord(w);
  1026.     except
  1027.       FErrorsOccured := True;
  1028.       raise;
  1029.     end;
  1030.   end;
  1031.  
  1032.   procedure TPhoaStreamer.WriteHeader;
  1033.   var s: String;
  1034.   begin
  1035.      // Write signature
  1036.     s := SPhoAFileSignature;
  1037.     Write(s[1], Length(s));
  1038.      // Write Revision Number
  1039.     WriteInt(FRevisionNumber);
  1040.   end;
  1041.  
  1042.   procedure TPhoaStreamer.WriteInt(i: Integer);
  1043.   begin
  1044.     Write(i, SizeOf(i));
  1045.   end;
  1046.  
  1047.   procedure TPhoaStreamer.WriteStringB(const s: String);
  1048.   var b: Byte;
  1049.   begin
  1050.     b := Min(High(b), Length(s));
  1051.     WriteByte(b);
  1052.     if b>0 then Write(s[1], b);
  1053.   end;
  1054.  
  1055.   procedure TPhoaStreamer.WriteStringI(const s: String);
  1056.   var i: Integer;
  1057.   begin
  1058.     i := Length(s);
  1059.     WriteInt(i);
  1060.     if i>0 then Write(s[1], i);
  1061.   end;
  1062.  
  1063.   procedure TPhoaStreamer.WriteStringW(const s: String);
  1064.   var w: Word;
  1065.   begin
  1066.     w := Min(High(w), Length(s));
  1067.     WriteWord(w);
  1068.     if w>0 then Write(s[1], w);
  1069.   end;
  1070.  
  1071.   procedure TPhoaStreamer.WriteWord(w: Word);
  1072.   begin
  1073.     Write(w, SizeOf(w));
  1074.   end;
  1075.  
  1076.    //-------------------------------------------------------------------------------------------------------------------
  1077.    // TPhoaFiler
  1078.    //-------------------------------------------------------------------------------------------------------------------
  1079.  
  1080.   constructor TPhoaFiler.Create(AMode: TPhoaStreamingMode; const sFilename: String);
  1081.   var AStream: TStream;
  1082.   begin
  1083.     try
  1084.        // Determine the file to read from or write to and create a file stream
  1085.       FFilename := sFilename;
  1086.       if AMode=psmWrite then begin
  1087.         FWriteFilename := FFilename+'.tmp';
  1088.         AStream := TFileStream.Create(FWriteFilename, fmCreate);
  1089.       end else
  1090.         AStream := TFileStream.Create(FFilename, fmOpenRead or fmShareDenyWrite);
  1091.        // Create the streamer
  1092.       inherited Create(AStream, AMode, ExtractFilePath(FFilename));
  1093.     except
  1094.       ErrorsOccured := True;
  1095.       raise;
  1096.     end;
  1097.   end;
  1098.  
  1099.   destructor TPhoaFiler.Destroy;
  1100.   begin
  1101.     Stream.Free;
  1102.      // On successful writing, replace the original file with new (.tmp)
  1103.     if (Mode=psmWrite) and not ErrorsOccured then begin
  1104.       DeleteFile(PChar(FFilename));
  1105.       MoveFile(PChar(FWriteFilename), PChar(FFilename));
  1106.     end;
  1107.     inherited Destroy;
  1108.   end;
  1109.  
  1110. end.
  1111.